This is a full application in Delphi (2.0) which illustrates how to use Delphi and OLE to connect to the application IMSI SDK server, load drawings, draw graphics on screen, get properties and scroll and zoom the drawings.
unit Preview;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, FileCtrl, Menus, Grids, Buttons;
type
TPreviewForm = class(TForm)
ButtonQuit: TButton;
LoadTCFile: TButton;
OpenDrawingFileDialog: TOpenDialog;
StatusBar: TStatusBar;
ButtonZoomMinus: TButton;
CBDisplayDrawingName: TComboBox;
PaintBox1: TPaintBox;
HorizontalScrollBar: TScrollBar;
VerticalScrollBar: TScrollBar;
Label2: TLabel;
Label3: TLabel;
ButtonZoomPlus: TButton;
ButtonDraw: TButton;
PopupMenu1: TPopupMenu;
Circle1: TMenuItem;
Line1: TMenuItem;
ButtonNew: TButton;
ButtonShowProperties: TButton;
ButtonCircle: TSpeedButton;
ButtonSpline: TSpeedButton;
ButtonLine: TSpeedButton;
ButtonStar: TSpeedButton;
ButtonPickPoint: TSpeedButton;
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ButtonQuitClick(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure LoadTCFileClick(Sender: TObject);
procedure LoadTCFileMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure VerticalScrollBarScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure HorizontalScrollBarScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure ButtonZoomPlusClick(Sender: TObject);
procedure ButtonZoomMinusClick(Sender: TObject);
procedure ButtonZoomMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ButtonClearClick(Sender: TObject);
procedure ButtonDrawClick(Sender: TObject);
procedure ButtonNewClick(Sender: TObject);
procedure Circle1Click(Sender: TObject);
procedure Line1Click(Sender: TObject);
procedure ButtonShowPropertiesClick(Sender: TObject);
procedure PaintBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure PaintBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ButtonLineClick(Sender: TObject);
procedure ButtonCircleClick(Sender: TObject);
procedure ButtonSplineClick(Sender: TObject);
procedure ButtonStarClick(Sender: TObject);
procedure ButtonPickPointClick(Sender: TObject);
procedure PaintBox1StartDrag(Sender: TObject;
var DragObject: TDragObject);
private
{ Private declarations }
public
{ Public declarations }
SDKApp : Variant; { the overall OLE application object }
SDKViews: Variant; { the overall SDK View object }
TheView: Variant; { the particuler instance of the view }
SDKDrawings : Variant; { the overall SDK Drawing }
TheDrawing : Variant; { the particular instance of the drawing }
Graphics, pIGraphic: Variant; { Graphic variants used for drawing on screen }
TCFileName : String;
ViewLeft, ViewTop, ViewWidth, ViewHeight: Double; { View coordinates }
ScrollCenterX, ScrollCenterY: Double; { Dead center for scrolling }
ScrollRangeX, ScrollRangeY: Double; { Scroll range }
xStart, yStart: Double; { Coordinates of start point of draw object }
DragStarted: Boolean;
SplineStarted: Boolean;
PointPicked: Boolean;
SelectedGraphic: Variant;
procedure LoadTheDrawing(FileName: String);
procedure ViewSetScrollPos;
procedure UpdateScrollParams;
procedure ViewZoomBy(Factor: Double);
procedure ViewScrollBy(DeltaX: Double; DeltaY: Double);
procedure PaintBoxRePaint;
procedure NewDrawing;
end;
var
PreviewForm: TPreviewForm;
implementation
{$R *.DFM}
uses OleAuto, PopUp, Properties;
function VarValid(AVar: Variant): Boolean;
begin
Result := (VarType(AVar) <> varEmpty) and (not VarIsNull(AVar));
end;
procedure TPreviewForm.FormCreate(Sender: TObject);
begin
SDKApp := NULL;
SDKViews := NULL;
TheView := NULL;
SDKDrawings := NULL;
TheDrawing := NULL;
SelectedGraphic := NULL;
{ Create the OLE link to the TC SDK Application as IN-PROC server}
SDKApp := CreateOleObject('IMSIGX.Application');
{ to connect to TurboCad as Local Server use:
SDKApp := CreateOleObject('TurboCAD.Application'); }
SDKDrawings := SDKApp.Drawings; { Get the Drawings Collection to hold our drawings }
TCFileName := '';
DragStarted := false;
SplineStarted := false;
PointPicked := false;
NewDrawing; { set up a new drawing }
end;
procedure TPreviewForm.FormDestroy(Sender: TObject);
begin
if VarValid(TheView) then VarClear(TheView);
if VarValid(SDKViews) then VarClear(SDKViews);
if VarValid(pIGraphic) then VarClear(pIGraphic);
if VarValid(TheDrawing) then
begin
TheDrawing.Close;
VarClear(TheDrawing);
end;
if VarValid(SDKDrawings) then VarClear(SDKDrawings);
if VarValid(SDKApp) then VarClear(SDKApp);
end;
procedure TPreviewForm.ButtonQuitClick(Sender: TObject);
begin
close;
end;
procedure TPreviewForm.PaintBox1Paint(Sender: TObject);
begin
PaintBoxRePaint;
end;
procedure TPreviewForm.LoadTCFileClick(Sender: TObject);
var nItem: Integer;
begin
{ Turn off spline }
SplineStarted := false;
DragStarted := false;
TCFileName := '';
{ load the drawing from a group of files in a directory }
{ First display Dialog file selection and choose from available files }
if OpenDrawingFileDialog.Execute then
begin
TCFileName := OpenDrawingFileDialog.FileName;
PreviewForm.Caption := OpenDrawingFileDialog.FileName;
nItem := CBDisplayDrawingName.Items.Add(OpenDrawingFileDialog.FileName);
CBDisplayDrawingName.ItemIndex := nItem;
if pos('.tcw', TCFileName) > 2 then
LoadTheDrawing(TCFileName);
StatusBar.SimpleText := 'Right click on button, object or screen to see the code for the procedure';
end;
end;
{ Note: this will be replaced by simple call to TheView.ZoomBy when it is }
{ added to the SDK. }
procedure TPreviewForm.ViewZoomBy(Factor: Double);
var
CanvasDC: HDC;
VCenterX, VCenterY: Double;
ViewChanged: Boolean;
begin
if VarValid(TheDrawing) and VarValid(TheView) then
begin
ViewChanged := False;
{ Obtain the Device Context for the PaintBox canvas. }
CanvasDC := PaintBox1.Canvas.Handle;
TheView.Update := False; { Delay update until we tell it to. }
TheView.DC := CanvasDC;
TheView.MappingMode := MM_TEXT;
TheView.FixedAspectRatio := TRUE;
{ See if we need to start over. }
if (Factor <= 0.0) or ((ViewWidth = 0) and (ViewHeight = 0)) then
begin
{ Factor <= 0.0 means reset. Otherwise, initial settings. }
TheView.ScreenLeft := 0.0;
TheView.ScreenTop := 0.0;
TheView.ScreenWidth := PaintBox1.Width;
TheView.ScreenHeight := PaintBox1.Height;
TheView.ZoomToExtents; { zoom to largest drawing area }
ViewLeft := TheView.ViewLeft;
ViewTop := TheView.ViewTop;
ViewWidth := TheView.ViewWidth;
ViewHeight := TheView.ViewHeight;
ViewChanged := True;
end;
if (Factor > 0.0) and (Factor <> 1.0) then
begin
{ Keep the center fixed, and change view coordinates. }
VCenterX := ViewLeft + (ViewWidth/2.0);
VCenterY := ViewTop - (ViewHeight/2.0);
ViewWidth := ViewWidth / Factor;
ViewHeight := ViewHeight / Factor;
ViewLeft := VCenterX - (ViewWidth/2.0);
ViewTop := VCenterY + (ViewHeight/2.0);
ViewChanged := True;
end;
{ Synchronize the view to our new location and zoom. }
TheView.ViewLeft := ViewLeft;
TheView.ViewTop := ViewTop;
TheView.ViewWidth := ViewWidth;
TheView.ViewHeight := ViewHeight;
{ Update display. }
PaintBoxRePaint;
{ Keep scroll bars in sync. }
if ViewChanged then UpdateScrollParams;
end;
end;
{ this loads the drawing from the disk using IMSI SDK }
procedure TPreviewForm.LoadTheDrawing(FileName: String);
const
MM_TEXT = 1;
var
var1, var2: Variant;
canvasRect: TRect;
EVar: String;
begin
if VarValid(SDKApp) and (FileName <> '') then
begin
try
begin
var1 := null;
var2 := null;
PaintBox1.Canvas.Brush.Color := clWhite;
canvasRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Width);
PaintBox1.Canvas.FillRect(canvasRect);
{ Close any previous open drawings }
if VarValid(TheView) then
begin
VarClear(TheView);
TheView := NULL;
end;
if VarValid(SDKViews) then
begin
VarClear(SDKViews);
SDKViews := NULL;
end;
if VarValid(TheDrawing) then
begin
TheDrawing.Close(false);
VarClear(TheDrawing);
TheDrawing := NULL;
end;
{ open the graphic TCW file using the SDK method }
TheDrawing := SDKDrawings.Open(FileName);
SDKViews := TheDrawing.Views;
TheView := SDKViews.Add();
{ now that we have the particular view for the drawing, call the our
repaint procedure to handle the painting using the SDK, we set
the new global coordinates to accomplish the painting }
{ ViewWidth = 0.0 and ViewHeight = 0.0 mean initial settings }
ViewWidth := 0.0;
ViewHeight := 0.0;
ViewLeft := 0.0;
ViewTop := 0.0;
ViewZoomBy(0.0); { Specifying 0.0 as the zoom factor redraws... }
end;
except
on E:Exception do
MessageDlg('Exception Occurred: ' + E.Message, mtInformation, [mbOk], 0);
end;
end;
end;
procedure TPreviewForm.LoadTCFileMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
begin
FormPopUp.Top := PreviewForm.ClientOrigin.Y + (Sender as TButton).Top + (Sender as TButton).Height + 5;
FormPopUp.Left := (PreviewForm.ClientOrigin.X + (Sender as TButton).Left + X) - (FormPopUp.Width div 2);
FormPopUp.SetFileName('LoadFile.rtf');
FormPopUp.show;
end;
end;
procedure TPreviewForm.PaintBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var vX, vY: Double;
DispText: String;
begin
if Button = mbRight then
begin
FormPopUp.Top := PreviewForm.ClientOrigin.Y + Y + (Sender as TPaintBox).Top + 5;
FormPopUp.Left := (PreviewForm.ClientOrigin.X + X) - (FormPopUp.Width div 2);
FormPopUp.SetFileName('CreateForm.rtf');
FormPopUp.show;
end;
if Button = mbLeft then
begin
DispText := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y);
if VarValid(TheDrawing) and VarValid(TheView) then
begin
TheView.ScreenToView(X, Y, vX, vY);
DispText := DispText + ' View -> X: ' + FloatToStr(vX) + ' Y: ' + FloatToStr(vY);
DispText := DispText + ' VL: ' + FloatToStr(TheView.ViewLeft);
{' VT: ' + FloatToStr(TheView.ViewTop) + ' VW: ' + FloatToStr(TheView.ViewWidth) +
' VH: ' + FloatToStr(TheView.ViewHeight);
}
if ButtonCircle.Down then
begin
Graphics := TheDrawing.Graphics; { get the graphic to start drawing }
xStart := X;
yStart := Y;
end
else if ButtonLine.Down then
begin
end;
end;
StatusBar.SimpleText := DispText;
end;
end;
{ Should be called whenever Drawing's bounding box, or Viewport is changed. }
procedure TPreviewForm.UpdateScrollParams;
var
VarDummy: Variant;
BBox, BoxMin, BoxMax: Variant;
X1, Y1, X2, Y2: Double;
Delta1, Delta2: Double;
begin
Label2.Visible := True;
Label3.Visible := True;
HorizontalScrollBar.Visible := True;
HorizontalScrollBar.Min := 0;
HorizontalScrollBar.Max := 32000;
HorizontalScrollBar.LargeChange := 3200;
HorizontalScrollBar.SmallChange := 320;
VerticalScrollBar.Visible := True;
VerticalScrollBar.Min := 0;
VerticalScrollBar.Max := 32000;
VerticalScrollBar.LargeChange := 3200;
VerticalScrollBar.SmallChange := 320;
{ Arbitrary limits if all else fails. }
ScrollCenterX := 0.0;
ScrollCenterY := 0.0;
ScrollRangeX := 1.0;
ScrollRangeY := 1.0;
if VarValid(TheDrawing) then
begin
X1 := ViewLeft;
Y1 := ViewTop - ViewHeight;
X2 := ViewLeft + ViewWidth;
Y2 := ViewTop;
try
{ Set ScrollCenter to center of drawing's graphics. }
Graphics := TheDrawing.Graphics;
TVarData(varDummy).VType := varError;
TVarData(varDummy).VError := DISP_E_PARAMNOTFOUND;
BBox := Graphics.CalcBoundingBox( VarDummy );
if not BBox.Empty then
begin
BoxMin := BBox.Min;
BoxMax := BBox.Max;
X1 := BoxMin.X;
Y1 := BoxMin.Y;
X2 := BoxMax.X;
Y2 := BoxMax.Y;
ScrollCenterX := (X1 + X2)/2.0;
ScrollCenterY := (Y1 + Y2)/2.0;
{ Set min and max for range to include current viewport. }
if ViewLeft < X1 then X1 := ViewLeft;
if (ViewTop - ViewHeight) < Y1 then Y1 := ViewTop - ViewHeight;
if (ViewLeft + ViewWidth) > X2 then X2 := ViewLeft + ViewWidth;
if ViewTop > Y2 then Y2 := ViewTop;
end;
except
end;
{ Set ScrollRange based on largest area included. }
Delta1 := ScrollCenterX - X1;
Delta2 := X2 - ScrollCenterX;
if Delta1 > Delta2 then ScrollRangeX := 2.0 * Delta1
else ScrollRangeX := 2.0 * Delta2;
Delta1 := ScrollCenterY - Y1;
Delta2 := Y2 - ScrollCenterY;
if Delta1 > Delta2 then ScrollRangeY := 2.0 *Delta1
else ScrollRangeY := 2.0 * Delta2;
end;
ViewSetScrollPos;
end;
function MyRound(D: Double): Integer;
var
ConvertString: String;
begin
ConvertString := FloatToStrF(D, ffFixed, 18, 0);
Result := StrToInt(ConvertString);
end;
procedure TPreviewForm.ViewSetScrollPos;
var
VCenter: Double;
IMax: Integer;
DMax: Double;
DPos: Double;
IPos: Integer;
begin
if ScrollRangeX > 0.0 then
begin
IMax := HorizontalScrollBar.Max;
DMax := IMax;
VCenter := ViewLeft + (ViewWidth / 2.0);
DPos := (DMax / 2.0) +
DMax * (VCenter - ScrollCenterX)/ScrollRangeX;
if DPos <= 0.0 then IPos := 0
else if DPos >= DMax then IPos := IMax
else IPos := MyRound(DPos);
HorizontalScrollBar.Position := IPos;
end;
if ScrollRangeY > 0.0 then
begin
IMax := VerticalScrollBar.Max;
DMax := IMax;
VCenter := ViewTop - (ViewHeight / 2.0);
DPos := (DMax / 2.0) +
DMax * (VCenter - ScrollCenterY)/ScrollRangeY;
if DPos < 0.0 then IPos := 0
else if DPos > DMax then IPos := IMax
else IPos := MyRound(DPos);
VerticalScrollBar.Position := IPos;
end;
end;
procedure TPreviewForm.ViewScrollBy(DeltaX: Double; DeltaY: Double);
begin
ViewLeft := ViewLeft + DeltaX;
ViewTop := ViewTop + DeltaY;
ViewZoomBy(1.0);
end;
procedure TPreviewForm.VerticalScrollBarScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
var
Y, YOrig: Double;
DPos, DMax: Double;
begin
if VarValid(TheDrawing) and VarValid(TheView) then
begin
Y := ViewTop - (ViewHeight/2.0); { Center point of view. }
YOrig := Y;
case ScrollCode of
scLineUp: Y := Y + (ViewHeight/32.0); { scroll in the +Y direction }
scPageUp: Y := Y + (ViewHeight/8.0); { scroll in the +Y direction }
scLineDown: Y := Y - (ViewHeight/32.0); { scroll in the -Y direction }
scPageDown: Y := Y - (ViewHeight/8.0); { scroll in the -Y direction }
scTrack:
begin
DPos := ScrollPos;
DMax := VerticalScrollBar.Max;
Y := ScrollCenterY -
(DPos / DMax - 0.5) * ScrollRangeY;
end
else Exit;
end;
ViewScrollBy(0.0, Y - YOrig);
end;
end;
procedure TPreviewForm.HorizontalScrollBarScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
var
X, XOrig: Double;
DPos, DMax: Double;
begin
if VarValid(TheDrawing) and VarValid(TheView) then
begin
X := ViewLeft + (ViewWidth/2.0); { Center point of view. }
XOrig := X;
case ScrollCode of
scLineUp: X := X - (ViewWidth/32.0); { scroll in the -X direction }
scPageUp: X := X - (ViewWidth/8.0); { scroll in the -X direction }
scLineDown: X := X + (ViewWidth/32.0); { scroll in the +X direction }
scPageDown: X := X + (ViewWidth/8.0); { scroll in the +X direction }
scTrack:
begin
DPos := ScrollPos;
DMax := HorizontalScrollBar.Max;
X := ScrollCenterX +
(DPos / DMax - 0.5) * ScrollRangeX;
end
else Exit;
end;
ViewScrollBy(X - XOrig, 0.0);
end;
end;
procedure TPreviewForm.ButtonZoomPlusClick(Sender: TObject);
begin
{ Turn off spline }
SplineStarted := false;
DragStarted := false;
ViewZoomBy(1.414);
end;
procedure TPreviewForm.ButtonZoomMinusClick(Sender: TObject);
begin
{ Turn off spline }
SplineStarted := false;
DragStarted := false;
ViewZoomBy(0.707);
end;
procedure TPreviewForm.ButtonZoomMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
begin
FormPopUp.Top := PreviewForm.ClientOrigin.Y + (Sender as TButton).Top + (Sender as TButton).Height + 5;
FormPopUp.Left := (PreviewForm.ClientOrigin.X + (Sender as TButton).Left + X) - (FormPopUp.Width div 2);
FormPopUp.SetFileName('zoom.rtf');
FormPopUp.show;
end;
end;
{ This procedure repaints the screen with the current picture }
procedure TPreviewForm.PaintBoxRePaint;
const
MM_TEXT = 1;
var CanvasDC: HDC;
canvasRect: TRect;
ViewChanged: Boolean;
begin
{ clear the screen to white first }
canvasRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(canvasRect);
if VarValid(TheDrawing) and VarValid(TheView) then
begin
{ obtain the Device Context for the paintBox canvas }
CanvasDC := PaintBox1.Canvas.Handle;
TheView.Update := FALSE; { delay update until we tell it to }
TheView.DC := CanvasDC;
TheView.MappingMode := MM_TEXT;
TheView.FixedAspectRatio := TRUE;
ViewChanged := (ViewWidth = 0) and (ViewHeight = 0);
if ViewChanged then
begin
{ Initial settings }
TheView.ScreenLeft := canvasRect.Left;
TheView.ScreenTop := canvasRect.Top;
TheView.ScreenWidth := canvasRect.Right - canvasRect.Left;
TheView.ScreenHeight := canvasRect.Bottom - canvasRect.Top;
TheView.ZoomToExtents;
end
else
begin
{ Saved settings }
TheView.Refresh;
end;
ViewLeft := TheView.ViewLeft;
ViewTop := TheView.ViewTop;
ViewWidth := TheView.ViewWidth;
ViewHeight := TheView.ViewHeight;
if ViewChanged then UpdateScrollParams;
end;
end;
procedure TPreviewForm.ButtonClearClick(Sender: TObject);
begin
{ clear the screen of the any drawing }
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
{ remove any Variant association and close the drawing }
if VarValid(TheView) then
begin
VarClear(TheView);
TheView := NULL;
end;
if VarValid(SDKViews) then
begin
VarClear(SDKViews);
SDKViews := NULL;
end;
if VarValid(TheDrawing) then
begin
TheDrawing.Close(false);
VarClear(TheDrawing);
TheDrawing := NULL;
end;
UpdateScrollParams;
end;
procedure TPreviewForm.ButtonDrawClick(Sender: TObject);
begin
{ Turn off spline }
SplineStarted := false;
DragStarted := false;
PopupMenu1.AutoPopup := False;
PopupMenu1.Popup(PreviewForm.ClientOrigin.X + ButtonDraw.Left, PreviewForm.ClientOrigin.Y + ButtonDraw.Top + ButtonDraw.Height);
end;
procedure TPreviewForm.ButtonNewClick(Sender: TObject);
begin
{ Turn off spline }
SplineStarted := false;
DragStarted := false;
if VarValid(SDKApp) then
begin
NewDrawing; { set up a new drawing }
end;
end;
procedure TPreviewForm.Circle1Click(Sender: TObject);
var
xc, yc, zc, xp, yp, zp: double;
vh, vw, vl, vt, vx, vy: double;
vLeft, vTop: double;
begin
{ turn off spline and drag }
SplineStarted := false;
DragStarted := false;
{ Circle from center }
{ make sure that a drawing is ready for use }
if VarValid(TheView) and VarValid(TheDrawing) then
begin
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
xc := (TheView.ViewLeft + TheView.ViewWidth) / 2.0;
yc := (TheView.ViewTop - TheView.ViewHeight) / 2.0;
zc := 0.0;
xp := TheView.ViewLeft;
yp := TheView.ViewTop;
zp := 0.0;
Graphics := TheDrawing.Graphics;
pIGraphic := Graphics.AddCircleCenterAndPoint(xc, yc, zc, xp, yp, zp);
PaintBoxRePaint;
UpdateScrollParams;
end;
end;
procedure TPreviewForm.Line1Click(Sender: TObject);
{ draw a line on screen }
var
xc, yc, zc, xp, yp, zp: double;
vh, vw, vl, vt: double;
begin
{ turn off spline and drag }
SplineStarted := false;
DragStarted := false;
{ Line from two points }
{ make sure that a drawing is ready for use }
if VarValid(TheView) and VarValid(TheDrawing) then
begin
{ clear screen first }
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
{ we need to draw in view coordinates not screen coordinates as the drawing
by default is in inches. Remember that the default is: inches with the screen
center as 0.0, 0.0}
xc := (TheView.ViewWidth) / 2.0;;
yc := 0.0;
zc := 0.0;
xp := (TheView.ViewLeft) + (TheView.ViewWidth / 2.0);
yp := 0.0;
zp := 0.0;
xc := (TheView.ViewLeft + TheView.ViewWidth) / 2.0;
yc := (TheView.ViewTop - TheView.ViewHeight) / 2.0;
zc := 0.0;
xp := TheView.ViewLeft;
yp := TheView.ViewTop;
Graphics := TheDrawing.Graphics;
pIGraphic := Graphics.AddLineSingle(xc, yc, zc, xp, yp, zp);
PaintBoxRePaint;
UpdateScrollParams;
end;
end;
procedure TPreviewForm.ButtonShowPropertiesClick(Sender: TObject);
var pItem, pProps, ValueStr: Variant;
pTypeName, pName, TypeStr: String;
pType: Integer;
pValue: Variant;
Count, ii, TotalWidth: Integer;
isArray: Boolean;
Col0, Col1, Col2: Integer;
begin
if VarValid(SDKApp) then
begin
pProps := NULL;
pProps := TheDrawing.Properties;
Count := pProps.Count;
Col0 := 0; Col1 := 0; Col2 := 0; TotalWidth := 0;
with FormProperties.StringGridProperties do
begin
Cells[0, 0] := 'Property';
if Canvas.TextWidth('Property') > Col0 then Col0 := Canvas.TextWidth('Property');
Cells[1, 0] := 'Type';
if Canvas.TextWidth('Type') > Col1 then Col1 := Canvas.TextWidth('Type');
Cells[2, 0] := 'Value';
if Canvas.TextWidth('Value') > Col2 then Col2 := Canvas.TextWidth('Value');
RowCount := 1;
for ii:=0 to Count-1 do
begin
{ This is the way to access a property which takes a parameter }
{ Item(Parameter) must be used as an array Item[parameter] }
pItem := pProps.Item[ii];
RowCount := RowCount + 1;
{ get the name of the property }
pName := pItem.Name;
{ find max width to set col, This uses the Canvas method TextWidth to
find the string width in pixels }
if Canvas.TextWidth(pName) > Col0 then Col0 := Canvas.TextWidth(pName);
Cells[0, ii+1] := pName;
{ we need a try - exception here because the return may throw an exception on 'no value' }
try
pType := pItem.Type;
isArray := False;
if (pType and varArray) <> 0 then
begin
isArray := True;
pType := pType and (not varArray);
end;
{ we need to define what the TYPE means in english }
case pType of
varEmpty: { VT_EMPTY } pTypeName := 'Empty';
varSmallint: { VT_I2 } pTypeName := 'Integer';
varInteger: { VT_I4 } pTypeName := 'Long';
varSingle: { VT_R4 } pTypeName := 'Real';
varDouble: { VT_R8 } pTypeName := 'Double';
varOleStr: { VT_BSTR } pTypeName := 'String';
varBoolean: { VT_BOOL } pTypeName := 'Boolean';
varByte: { VT_UI1 } pTypeName := 'Byte';
else pTypeName := 'Unknown (' + IntToStr(pType) + ')';
end;
{ if an array type then add extra wording }
if isArray then
begin
TypeStr := 'Array of ' + pTypeName;
Cells[1, ii+1] := TypeStr;
if Canvas.TextWidth(TypeStr) > Col1 then Col1 := Canvas.TextWidth(TypeStr);
end
else
begin
Cells[1, ii+1] := pTypeName;
if Canvas.TextWidth(pTypeName) > Col1 then Col1 := Canvas.TextWidth(pTypeName);
end;
except
Cells[1, ii+1] := 'Error';
end;
try
PValue := pItem.Value;
if VarType(PValue) in [varSmallint, varInteger, varSingle, varDouble, varOleStr, varBoolean, varByte] then
VarCast (ValueStr, pValue, varString) { convert to string }
else
ValueStr := 'Unknown';
Cells[2, ii+1] := ValueStr;
if Canvas.TextWidth(ValueStr) > Col2 then Col2 := Canvas.TextWidth(ValueStr);
except
if Canvas.TextWidth('Error') > Col2 then Col2 := Canvas.TextWidth('Error');
Cells[2, ii+1] := 'Error';
end;
end;
ColWidths[0] := Col0 + 5;
ColWidths[1] := Col1 + 5;
ColWidths[2] := Col2 + 5;
TotalWidth := Col0 + Col1 + Col2 + 15;
Width := TotalWidth + 25;
FormProperties.Width := Width + 10;
FixedRows := 1;
end;
FormProperties.show;
VarClear(pProps);
VarClear(pItem);
end;
end;
procedure TPreviewForm.PaintBox1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var vX, vY: Double;
DispText: String;
TheStar: Variant;
begin
DispText := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y);
if VarValid(TheView) then
begin
if not DragStarted then
begin
if (ButtonCircle.Down) or (ButtonLine.Down) or (ButtonStar.Down) or (ButtonPickPoint.Down) then
begin
{ This starts the drawing fixing the first point as xStart and yStart }
{ first get the view coordinates from the screen coordinates of the
mouse click }
TheView.ScreenToView(X, Y, vX, vY);
Graphics := TheDrawing.Graphics; { get the graphic to start drawing }
xStart := vX;
yStart := vY;
DragStarted := true;
if ButtonPickPoint.Down then
PointPicked := true;
{ display in status box }
DispText := DispText + ' View -> X: ' + FloatToStr(vX) + ' Y: ' + FloatToStr(vY);
varClear(pIGraphic);
end
else if ButtonSpline.Down then
begin
if not SplineStarted then
begin
TheView.ScreenToView(X, Y, vX, vY);
Graphics := TheDrawing.Graphics; { get the graphic to start drawing }
xStart := vX;
yStart := vY;
DragStarted := true;
{ display in status box }
DispText := DispText + ' View -> X: ' + FloatToStr(vX) + ' Y: ' + FloatToStr(vY);
end;
end
else
begin
{ no draw button down, so just display coordinates }
TheView.ScreenToView(X, Y, vX, vY);
DispText := DispText + ' View -> X: ' + FloatToStr(vX) + ' Y: ' + FloatToStr(vY);
end;
end
else { still dragging the mouse }
begin
{ if we wish to rubber bank the drawing object we have to erase the
previous object and draw the temporary object from new positions }
{ just display the coordinates to the StatusBox }
TheView.ScreenToView(X, Y, vX, vY);
DispText := DispText + ' View -> X: ' + FloatToStr(vX) + ' Y: ' + FloatToStr(vY);
end;
end;
{ display coordinates of mouse to Status Box }
StatusBar.SimpleText := DispText;
end;
{ This procedure shows how to draw on the screen in various way after a mouse click and move (drag) }
procedure TPreviewForm.PaintBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
var vX, vY: double;
pickCount, ii: Integer;
varX, varY, varZ: Double;
varDummy, ThePickedResults: Variant;
pIVertex, IVertices: Variant;
TheItem, PickGraphic, ThePenColor, pProp: Variant;
begin
if (DragStarted = true) and VarValid(TheView) and
((ButtonCircle.Down = true) or (ButtonLine.Down = true) or (ButtonSpline.Down = true) or
(ButtonStar.Down = true) or (ButtonPickPoint.Down = true)) then
begin
{ the user has now released the mouse button and we must draw the object with
the coordinates from this mouse point }
{ clear the screen first. This would not be necessary if the drawing scale wasn't changing }
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
{ get the view coordinates for the screen mouse position }
TheView.ScreenToView(X, Y, vX, vY);
{ with the start and ending coordinates we use the IMSI SDK to draw the circle line or slpine }
if ButtonCircle.Down = true then { draw circle center and radius point }
pIGraphic := Graphics.AddCircleCenterAndPoint(xStart, yStart, 0, vX, vY, 0)
else if ButtonLine.Down = true then { drawing line start and end point }
pIGraphic := Graphics.AddLineSingle(xStart, yStart, 0, vX, vY, 0)
else if ButtonSpline.Down = true then { draw spline, start point and subsequent mouse drag points }
begin
{ First two points on spline come from draw Over and here from End drag }
if not SplineStarted then { first time through with spline }
begin
varX := xStart;
varY := yStart;
varZ := 0.0;
pIGraphic := Graphics.AddCurveSpline(varX, varY, 0.0);
SplineStarted := true; { mark as starting spline for subsequent mouse clicks and drags }
TVarData(varDummy).VType := varError;
TVarData(varDummy).VError := DISP_E_PARAMNOTFOUND;
IVertices := NULL;
IVertices := pIGraphic.Vertices;
varX := vX;
varY := vY;
varZ := 0.0;
pIVertex := NULL;
{pIvertex := IVertices.Add(varX, varY, varZ, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy);}
pIvertex := IVertices.Add(varX, varY, varZ,,,,,,,,); { add a vertex. Delphi allows commas as place holder }
if VarValid(pIVertex) then
VarClear(pIVertex);
if VarValid(IVertices) then
VarClear(IVertices);
end
else
begin
TVarData(varDummy).VType := varError;
TVarData(varDummy).VError := DISP_E_PARAMNOTFOUND;
IVertices := NULL;
IVertices := pIGraphic.Vertices;
varX := vX;
varY := vY;
varZ := 0.0;
pIVertex := NULL;
{pIvertex := IVertices.Add(varX, varY, varZ, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy, varDummy);}
pIvertex := IVertices.Add(varX, varY, varZ,,,,,,,,);
if VarValid(pIVertex) then
VarClear(pIVertex);
if VarValid(IVertices) then
VarClear(IVertices);
end;
end
else if ButtonStar.Down = true then { drawing Point, star, box or what ever }
begin
{ !!!!!!!!!!!!!!!!!!!! FAILS AT DBAPI/DBD.cpp Line 2108 !!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
pIGraphic := Graphics.AddStar(xStart, yStart, 0.0);
end
else if (ButtonPickPoint.Down = true) and (PointPicked = true) then { Pick point see if on graphic and highlite }
begin
try
StatusBar1.SimpleText := 'Count: ';
ThePickedResults := null;
ThePickedResults := TheView.PickPoint(xStart, yStart,0.1,,,,,,);
pickCount := ThePickedResults.Count;
if pickCount > 0 then
begin
{ First deselect the current selected graphic if any }
if VarValid(SelectedGraphic) then
begin
PickGraphic := SelectedGraphic;
pProp := NULL;
pProp := PickGraphic.Properties;
ThePenColor := NULL;
ThePenColor := pProp.Item['PenColor'];
ThePenColor.Value := $000000;
VarClear(SelectedGraphic);
SelectedGraphic := NULL;
end;
for ii := 0 to pickCount - 1 do
begin
TheItem := ThePickedResults.Item[ii]; { must pass the parameter as if an array }
PickGraphic := TheItem.Graphic;
pProp := NULL;
pProp := PickGraphic.Properties;
ThePenColor := NULL;
ThePenColor := pProp.Item['PenColor'];
ThePenColor.Value := $0000FF;
SelectedGraphic := PickGraphic;
VarClear(TheItem);
VarClear(PickGraphic);
VarClear(ThePenColor);
VarClear(pProp);
end;
StatusBar1.SimpleText := 'Count: ' + IntToStr(pickCount);
end;
VarClear (ThePickedResults);
PointPicked := false;
except
on E:Exception do
begin
StatusBar1.SimpleText := 'Count: 0';
if VarValid(ThePickedResults) then
VarClear(ThePickedResults);
{ do nothing as not graphic found at point }
end;
end;
end;
PaintBoxRePaint;
UpdateScrollParams;
{ clear the graphics variant }
if not SplineStarted then
begin
varClear(pIGraphic);
DragStarted := false;
end;
end;
end;
procedure TPreviewForm.ButtonLineClick(Sender: TObject);
begin
{ draws a line from mouse down to mouse up }
SplineStarted := false;
DragStarted := false;
end;
procedure TPreviewForm.ButtonCircleClick(Sender: TObject);
begin
StatusBar.SimpleText := 'Click and drag with mouse to draw circle';
SplineStarted := false;
DragStarted := false;
end;
procedure TPreviewForm.ButtonSplineClick(Sender: TObject);
begin
SplineStarted := false;
DragStarted := false;
end;
procedure TPreviewForm.ButtonStarClick(Sender: TObject);
begin
{ draw a Start. Could be any point object: point, circle, star, dot, square }
SplineStarted := false;
DragStarted := false;
end;
procedure TPreviewForm.ButtonPickPointClick(Sender: TObject);
begin
{ stop the spline if it is still waiting for points }
SplineStarted := false;
DragStarted := false;
PointPicked := false; { start the picking by setting to false to clear any previous click }
end;
procedure TPreviewForm.NewDrawing;
const
MM_TEXT = 1;
var
var1, var2: Variant;
canvasRect: TRect;
EVar, DispText: String;
begin
if VarValid(SDKApp) then
begin
try
begin
var1 := null;
var2 := null;
{ Close any previous open drawings }
if VarValid(TheView) then
begin
VarClear(TheView);
TheView := NULL;
end;
if VarValid(SDKViews) then
begin
VarClear(SDKViews);
SDKViews := NULL;
end;
if VarValid(TheDrawing) then
begin
TheDrawing.Close(false);
VarClear(TheDrawing);
TheDrawing := NULL;
end;
{ Get a new drawing using the SDK method }
TheDrawing := SDKDrawings.Add;
SDKViews := TheDrawing.Views;
TheView := SDKViews.Add();
{ now that we have the particular view for the drawing, call the our
repaint procedure to handle the painting using the SDK, we set
the new global coordinates to accomplish the painting}
ViewWidth := 0.0;{PaintBox1.Width;}
ViewHeight := 0.0;{PaintBox1.Height; }
ViewLeft := 0.0;
ViewTop := 0.0;
PaintBoxRePaint; { call the repaint procedure }
UpdateScrollParams;
DispText := 'VL: ' + FloatToStr(TheView.ViewLeft) +
' VT: ' + FloatToStr(TheView.ViewTop) + ' VW: ' + FloatToStr(TheView.ViewWidth) +
' VH: ' + FloatToStr(TheView.ViewHeight);
StatusBar1.SimpleText := DispText;
end;
except
on E:Exception do
MessageDlg('Exception Occurred: ' + E.Message, mtInformation, [mbOk], 0);
end;
end;
end;
procedure TPreviewForm.PaintBox1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
{ unfortunately DragStart does not pass mouse coordinates so must use DragOver }
end;
end.